home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 47.7z / BS1 part 47 / HiSoft BASIC v1.04 (1989)(HiSoft)(Disk 2 of 2)[h Band].7z / HiSoft BASIC v1.04 (1989)(HiSoft)(Disk 2 of 2)[h Band].adf / GetFile.bas < prev    next >
Encoding:
BASIC Source File  |  1989-03-16  |  1.3 KB  |  55 lines
  1.  
  2. ' a program showing the use of the ARP File Requestor
  3. ' IMPORTANT: will *not* work on versions of the compiler
  4. ' prior to 1.04 due to a bug; it will compile but not run correctly
  5.  
  6. DEFINT a-z
  7.  
  8. LIBRARY "arp.library"
  9. DECLARE FUNCTION FileRequest&(buffer&) LIBRARY
  10. DECLARE FUNCTION BaseName&(pathptr&) LIBRARY
  11. DECLARE SUB TackOn(path&,file&) LIBRARY
  12.  
  13. ' passed a complete pathname, breaks it up into path/filename
  14. ' then calls the ARP selector
  15. ' returns -1 if OK, 0 means Cancelled
  16. ' changes the parameter if OK selected
  17. FUNCTION GetFile%(fname$,message$)
  18. LOCAL path$,file$,buffer&(6),result&,term%
  19. ' split up the pathname as required
  20. path$=SPACE$(80)
  21. LSET path$=fname$+CHR$(0)
  22. file$=SPACE$(40)
  23. result&=BaseName(SADD(path$))
  24. POKEB result&,0                'into path$
  25. term%=result&-SADD(path$)
  26. LSET file$=RIGHT$(fname$,LEN(fname$)-term%)+CHR$(0)
  27.  
  28. ' get the FR_buffer set up and call ARP
  29. buffer&(0)=SADD(message$+CHR$(0))
  30. buffer&(1)=SADD(file$)
  31. buffer&(2)=SADD(path$)
  32. buffer&(3)=0                'window pointer
  33. buffer&(4)=0: buffer&(5)=0: buffer&(6)=0
  34. result&=FileRequest(VARPTR(buffer&(0)))
  35. IF result&=0 THEN
  36.     GetFile%=0
  37. ELSE
  38.     TackOn SADD(path$),SADD(file$)
  39.     fname$=LEFT$(path$,INSTR(path$,CHR$(0))-1)
  40.     GetFile%=-1
  41. END IF
  42. END FUNCTION
  43.  
  44.  
  45.  
  46. ' example code:
  47.  
  48. file$="test.bas"
  49. DO
  50. worked=GetFile(file$,"Select File")
  51. PRINT file$
  52. LOOP UNTIL worked=0            'until cancelled
  53.  
  54.  
  55.